00100		TITLE LOOP	;	SUBROUTINE LOOP(I,J,L,M,N)
00200		ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
00300		ENTRY	SORT2,UPDATE,NEWR
00400		EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
00500		EXTERNAL SC,SCX
00600		DEFINE FIXX(N)
00700	<	JUMPGE	N,.+5
00800		MOVNS	N
00900		FIX 	N,233000    
01000		MOVNS	N
01100		CAIA
01200		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01300				;	DIMENSION N(1)
01400		MM←1 ↔ NN←2 ↔ J←3
01500	LOOP:	0		;	DO 1 NN=I+L,J+L,K
01600		MOVE	1,@4(16)
01700		SUB 	1,@3(16) 	; MM IS IN 1
01800		MOVE	2,@(16)
01900		ADD	2,@3(16)	;I+L  -- NN, 1ST TIME
02000		MOVE	3,@1(16)
02100		ADD	3,@3(16)	;J+L
02200		MOVE	4,@2(16)	;K
02300		HRRZI	5,@5(16)		; ADR. OF N
02400		ADDI	2,-1(5)		; N(NN)
02500		ADDI	3,-1(5)
02600		JUMPL	4,LP3		; JUMP IF NEG. INCR.
02700		HRRM	1,.+1		; ADD IN MM 
02800	LP1:	MOVE	6,(2)
02900		MOVEM	6,(2)		;N(NN)=N(NN+MM)
03000		CAIGE	2,(3)
03100		AOJA	2,LP1
03200		JRA	16,6(16)
03300	LP3:	HRRM	1,.+1
03400	LP2:	MOVE	6,(2)		;NEG. INCR.
03500		MOVEM	6,(2)
03600		CAILE	2,(3)
03700		SOJA	2,LP2
03800		JRA 	16,6(16)	;	END
03900	
04000	PLACE:	0	;	FUNCTION PLACE(X)
04100	;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
04200	;	EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
04300		MOVN	2,@(16) ;	PLACE=R11-ABS(RD-X)
04400		FADR	2,XRN+=3999 	;END
04500		MOVMS	2
04600		MOVE 	0,.COMM.+=12	;R11
04700		FSBR	0,2
04800		JRA	16,1(16)
04900	
05000	FINDIT:	0    ;	FUNCTION FINDIT(N)
05100		SETZ   ;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
05200		HRRZ	1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
05300		HRRZI	2,PTR  ;	FINDIT=0
05400		ADDI	1,(2)  ;	L=PWDS(N)
05500		MOVE	2,-1(1) ;	IF(RN(L+1).NE.1)GO TO 377
05600		FIXX(2)         ;	IF(RN(L+2).EQ.R2)RETURN
05700		MOVEM	2,PTR+=251   ; SENDS BACK A NUM IN L
05800		HRRZI	3,XRN     ;377	FINDIT=-1
05900		ADDI	3,(2)   ;	END
06000		MOVE 5,(3)   ; RN(L+1)
06100		CAME	5,[1.0]
06200		JRST	FNEG
06300		MOVE	5,1(3)  ;RN(L+2)
06400		CAME	5,.COMM.
06500	FNEG:	SETO
06600		JRA	16,1(16)
06700	
06800	DPYNEW:	0    ;	SUBROUTINE DPYNEW
06900		JSA	16,ACCPOG    ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
07000		JUMP	[1]    ;	CALL ACCPOG(1)
07100		MOVE	2,DPY+=4251    ;	IF(IGO.GT.0)RETURN
07200		JUMPG	2,DB    ;	CALL DPYOUT(1)
07300		JSA	16,DPYOUT    ;	END
07400		JUMP	[1]
07500	DB:	JRA	16,(16)
07600	
07700	MVBEAM:	0  ;C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
07800		HRRZ	2,(16) ;	SUBROUTINE MVBEAM(R,I,JY,L,W)
07900		MOVE	5,@1(16)  ; I
08000		ADD	2,5  ;C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
08100		ADD	2,@2(16)  ;	DIMENSION R(1)
08200		MOVE	3,-1(2)  ;	Y=R(JY+I)
08300		MOVM	4,3   ;	Z=ABS(Y)
08400		CAMGE	4,[=100.0]  ;	IF(Z.LT.100.)GO TO 1
08500		JRST	MV1
08600		CAML	5,[6]
08700		JRST	MV1	;  IF(I.GT.5)GO TO 1
08800	;C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
08900		JSA	16,AMOD  ;	Y=AMOD(Y,100.)
09000		JUMP	3  
09100		JUMP	[=100.0]  ; 0 HAS Y
09200		MOVE	5,@4(16)  ;	X=Y+W
09300		FADR	5,0
09400		MOVM	6,5  ;	Z=Z-ABS(Y)+ABS(X)
09500		MOVM	7,0 ;C  PUTS ALL INTO POSITIVE
09600		FSBR	4,7
09700		FADR	4,6
09800		SKIPGE 	5  ;	IF(X)Z=-Z
09900		MOVNS	4    ; Z
10000		JRST 	MV2 ;	GO TO 2
10100	MV1:	FADR	3,@4(16)  ;1	Z=Y+W
10200		MOVE	4,3   ; Z NOW IN 4
10300	MV2:	HRRZI	3,@(16) ;2	R(L+I)=Z
10400		ADD	3,@3(16)
10500		ADD	3,@1(16)
10600		MOVEM	4,-1(3)  ; PUT IT IN R(L+I)
10700		JRA	16,5(16)	; END
10800	
10900	MVBX:	0   ;	SUBROUTINE MVBX(I)
11000	;     COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
11100		MOVE	2,@(16)  ;	EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
11200		ADD	2,KJY+1 ;	R(L+I)=R8+(R(JY+I)-R4)*RDIS
11300		HRRZI	4,XRN
11400		ADDI	2,(4)
11500		MOVE	3,-1(2)  ; R(JY+I)
11600		FSBR	3,.COMM.+5
11700		FMPR	3,.COMM.+=25  ; *RDIS
11800		FADR	3,.COMM.+=9   ; +R8
11900		MOVE	2,@(16)
12000		ADD	2,.COMM.+=24   ; + L
12100		ADDI	2,(4)
12200		MOVEM	3,-1(2)    ;R(L+I)
12300		JRA	16,1(16)
12400	
12500	JUGGLE:	0    ;	SUBROUTINE JUGGLE
12600	;	IMPLICIT INTEGER(A-Z)
12700	;	REAL PWDS,RN
12800	;	COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
12900	;     COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
13000		SOS	PTR+=250	;ITEM=ITEM-1
13100		HRRZI	15,XRN	;	JX=RN(MEDIT)+3   WD CNT OF OLD ITEM
13200	;C  I-IX IS WD CNT OF NEW ITEM
13300		ADD	15,DPY+=4250
13400		MOVE	14,-1(15)
13500		FIXX(14)
13600		ADDI	14,3  		; JX
13700		MOVE	13,PTR+=253	;JY=IX
13800		MOVE	11,PTR+=252	; I
13900		SUB	11,13
14000		SUB	11,14		;Z=I-IX-JX    SPACE CHANGE
14100		JUMPL	11,J2751   	;IF(Z)2751,172,751
14200		JUMPE	11,J172
14300		MOVE	5,PTR+=252 ;751   CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
14400		SUBI	5,1
14500		MOVE	10,DPY+=4250
14600		ADD	10,14
14700		JSA	16,LOOP
14800		JUMP	5
14900		JUMP	10
15000		JUMP	[-1]
15100		JUMP	11
15200		JUMP	[0]
15300		JUMP	XRN
15400		ADD	13,11		;JY=IX+Z
15500		JRST	J172		;GO TO 172
15600	J2751:	ADD	14,DPY+=4250 ;2751  CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
15700		ADD	14,11
15800		MOVE	5,11
15900		ADD	5,PTR+=253
16000		SOS	5
16100		MOVN	10,11
16200		JSA	16,LOOP
16300		JUMP	14
16400		JUMP	5
16500		JUMP	[1]
16600		JUMP	[0]
16700		JUMP	10
16800		JUMP	XRN
16900	J172:	HRRZI	12,XRN 		;  172	J=RN(JY)+2
17000		ADDI	12,(13) 		; JY
17100		MOVE	12,-1(12) 	;RN(JY)
17200		FIXX(12)
17300		ADDI	12,2		; J IS IN 12
17400		JSA	16,LOOP		;CALL LOOP(0,J,1,MEDIT,JY,RN)
17500		JUMP	[0]
17600		JUMP	12
17700		JUMP	[1]
17800		JUMP	DPY+=4250	; MEDIT
17900		JUMP 	13		; JY
18000		JUMP	XRN
18100		MOVE	12,PTR+=253	; I=IX+Z
18200		ADD	12,11		; Z IS IN 11
18300		MOVEM	12,PTR+=252
18400		MOVE	12,PTR+=250  	; 1751	X=ITEM+1
18500		ADDI	12,1	    	; X IS IN 12
18600		HRRZI	13,DPY+=4000   	; JX=WDS(X22+1)-WDS(X22)
18700		ADD	13,DL	
18800		MOVE	14,(13)   	; WDS(X22+1) IN 14  ADR. WDS(X22) IN 13
18900		SUB  	14,-1(13)	;JX IN 14
19000		HRRZI	10,DPY+=4000     	;  J=WDS(X+1)-WDS(X)
19100		ADDI	10,(12)
19200		MOVE	7,(10)		;WDS(X+1)
19300		SUB	7,-1(10)		;J IN 7
19400		MOVEM	7,MVBX		; STORE J
19500		SUB	7,14    	; Y=J-JX
19600		MOVE	14,-1(10)  	;  JX=WDS(X)+Y+1
19700		ADD	14,7
19800		ADDI	14,1		; JX IN 14
19900		JUMPL	7,J2851   	;  IF(Y)2851,182,282
20000		JUMPE	7,J182
20100		MOVE	15,(10) ;282  CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
20200		ADDI	15,2	  	; ARG 1
20300		MOVE	6,-1(13) 	;  ARG 2
20400		JSA	16,LOOP
20500		JUMP	15
20600		JUMP	6 
20700		JUMP	[-1]
20800		JUMP	7	  	; Y
20900		JUMP	[0]
21000		JUMP	DPY
21100		JRST	J182   		;  GO TO 182
21200	J2851:	MOVE	14,(13) ;2851  CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
21300		ADD	14,7		;+Y
21400		ADDI	14,1		; ARG 1
21500		MOVE	5,-1(10) 	;WDS(X)
21600		ADD	5,7
21700		ADDI	5,1		; ARG 2
21800		MOVNM	7,MVBEAM	; -Y IS STORED
21900		JSA	16,LOOP
22000		JUMP	14
22100		JUMP	5
22200		JUMP	[1]
22300		JUMP	[0]
22400		JUMP	MVBEAM
22500		JUMP	DPY
22600		MOVE	14,-1(10)  	; WDS(X)   JX=WDS(X)+1
22700		ADDI	14,1		; JX IN 14
22800	J182:	MOVE	5,-1(13)  ;182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
22900		ADDI	5,1   	;WDS(X22)+1
23000		JSA	16,LOOP
23100		JUMP	[1]
23200		JUMP	MVBX
23300		JUMP	[1]
23400		JUMP	5  
23500		JUMP	14 
23600		JUMP	DPY
23700		MOVE	2,DL    	; DO 183 K=X22+1,X
23800	;;	HRRZI	5,DPY+=4000  	; 183	WDS(K)=WDS(K)+Y
23900	;;	ADD	5,2
24000		HRRZI	3,PTR
24100		ADDI	3,(2)
24200		TLC	11,232000	; FLOAT Z
24300		FADR	11,11
24400	J183:	JUMPE	11,J184		;IF(Z.EQ.0)GO TO 184
24500		MOVE	4,(3)
24600		FADR	4,11		; ADD Z
24700		MOVEM	4,(3)		; PWDS(K)=PWDS(K)+Z
24800		ADDI	3,1	;UPDATE PWDS AND WDS
24900	J184:	JUMPE	7,J185
25000		MOVE	6,(13)
25100		ADD	6,7
25200		MOVEM	6,(13)
25300		ADDI	13,1
25400	J185:	CAIGE	2,(12)
25500		AOJA	2,J183
25600		HRRZI	2,DPY+=4000	;ST(2)=WDS(X)
25700		ADDI	2,(12)		;WDS(X+1) ADR.
25800		MOVE	2,-1(2)
25900		HRRZI	3,DPY
26000	;;	AOJ	3,
26100		MOVEM	2,1(3)
26200		SETZM	DL		;X22=0
26300		JRA	16,(16)
26400	
26500	SORT2:	0		;SUBROUTINE SORT2(RPOS,M)
26600		MOVEI	2,2	;DIMENSION RPOS(2,200)
26700	S3:	MOVE	6,2	;(K=L HERE)
26800		SETO	11,	;L=2
26900		HRRZI	3,@(16)	;3	J=-1
27000		MOVE	4,2	;RX=RPOS(1,L-1)
27100		SUBI	4,1	;L-1
27200		IMULI	4,2
27300		ADDI	4,(3)
27400		MOVE	5,-2(4)	;RX
27500	S2:	MOVE 	7,6	;	DO 2 K=L,M
27600	;;	LSH	7,1	;IF(RPOS(1,K).GE.RX)GO TO 2
27700		IMULI	7,2	;IF(RPOS(1,K).GE.RX)GO TO 2
27800		ADDI	7,(3)
27900		CAMG	5,-2(7)
28000		JRST	S1	; CONTINUE
28100		MOVE	5,-2(7)	;  RX=RPOS(1,K)
28200	;;C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
28300		MOVE 	11,6	;J=K
28400	S1:	CAMGE	6,@1(16)	;2	CONTINUE
28500		AOJA	6,S2
28600		JUMPL	11,S4	;IF(J)GO TO 4
28700		MOVE	12,2	;K=L-1
28800		SOS	12
28900		IMULI	12,2	;(K*2)
29000		ADD	12,3	;CALL EXCH(RPOS(1,K),RPOS(1,J))
29100		MOVE	10,-2(12)
29200	;;	LSH	11,1		;MULTS BY 2 (LEFT SHIFT)
29300		IMULI	11,2
29400		ADD	11,3
29500		EXCH	10,-2(11)
29600		MOVEM	10,-2(12)
29700		MOVE	10,-1(12)	;CALL EXCH(RPOS(2,K),RPOS(2,J))
29800		EXCH	10,-1(11)
29900		MOVEM	10,-1(12)
30000	S4:	CAMGE	2,@1(16)	;4	L=L+1
30100		AOJA	2,S3		;IF(L.LE.M)GO TO 3
30200		JRA	16,2(16)	;END
30300	
30400	XNOTE:	0		;FUNCTION XNOTE(J)
30500		MOVE 	3,@(16)		;COMMON/XRN/RN(4000)
30600		IMULI	3,12		;DIMENSION R(10,80)
30700		ADDI	3,XRN+=2993	;EQUIVALENCE (R,RN(3001))
30800		MOVE	2,(3)		;XNOTE=AMOD(R(4,J),100.)
30900		JSA	16,AMOD
31000		JUMP	2
31100		JUMP	[=100.0]
31200		JRA	16,1(16)	;END
31300	
31400	BAUTO:	0		;	SUBROUTINE BAUTO(J,L,K,N)
31500		MOVE	2,@(16)		;C  FOR AUTOMATIC BEAMS.
31600		ADDI	2,2  	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
31700		MOVEM	2,@(16)		;J=J+2
31800		MOVE	3,@3(16)
31900		MOVE	4,@1(16)
32000		SUB	4,3		;L-N
32100		MOVE	5,@2(16)
32200		SUB	5,3		;K-N
32300		HRRZI	6,SCM
32400		ADDI	6,(2)
32500		TLC	4,232000
32600		FADR	4,4		;FLOATS IT
32700		MOVEM	4,-2(6)		;V(J-1)=L-N
32800		TLC	5,232000
32900		FADR	5,5		;FLOATS IT
33000		MOVEM	5,-1(6)		;V(J)=K-N
33100		JRA	16,4(16)
33200	
33300	UPDATE:	0	;	SUBROUTINE UPDATE(I)
33400		HRRZI	3,XRN  ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
33500		ADD	3,PTR+=252	;RN(IS)=I
33600		MOVE	2,@(16)
33700		TLC	2,232000	;FLOAT I
33800		FADR	2,2
33900		MOVEM	2,-1(3)
34000		MOVE	2,PTR+=252
34100		ADD	2,@(16)
34200		ADDI	2,3
34300		MOVEM	2,PTR+=252	;IS=IS+I+3
34400		JRA	16,1(16)
34500	
34600	JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13
34700	IK:	0
34800	JIT:	0  ; THESE ARE TO STORE PNTRS IN LOOP
34900	NEWR:	0	;	SUBROUTINE NEWR
35000		MOVE	A,SC+=70	;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
35100		CAIE	A,1		;COMMON/XRN/RN(4000)
35200		JRST	N1	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
35300		MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(20),JX,U,JZ,IRHY,J4,KA,KB,IZ
35400		MOVEM JK,IK  ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
35500		MOVE JT,PTR+=250  ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
35600	 	MOVEM	JT,JIT  	;DIMENSION R(10,80)	
35700	N1:	MOVE	IS,IK		;EQUIVALENCE (R,RN(3001))
35800		MOVEM	IS,PTR+=252
35900		MOVE 	JT,JIT		;IF(MODE.NE.1)GO TO 1
36000		ADDI	JT,1		;IK=IS
36100		MOVEM	JT,PTR+=250	;JIT=ITEM
36200		MOVEI	K,=10		;1	IS=IK
36300		MOVE	IZ,SCX+=31	;ITEM=JIT+1
36400		IMULI	IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
36500	N2:	HRRZI	R,XRN+=2997	;DO 2 K=1,IZ
36600		ADD	R,K		;IF(R(8,K).EQ.9999.)GO TO 2
36700		MOVE	R,(R)
36800		CAMN	R,[=9999.0]
36900		JRST	NN2  ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
37000		SETO	IEND,		;C  JUMP FOR BEAM CONT.
37100		HRRZI	L,XRN		;IEND=-1
37200		ADD	L,PTR+=252	;RN(IS+3)=0
37300		SETZM	2(L)
37400		SETZM	1(L)		;RN(IS+2)=0
37500		MOVEI	L,=9 ;C  ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
37600	N3:	HRRZI	R,XRN+=3000	;DO 3 L=9,1,-1
37700		ADDI	R,(K)		;A=R(L,K)
37800		ADDI	R,(L)
37900		MOVE	A,-13(R)	;(OCTAL)=-11
38000		JUMPGE	IEND,NX4	;IF(A.NE.0)GO TO 77
38100		JUMPN	A,NX3		;IF(IEND)GO TO 3
38200		JRST	NN3
38300	NX3:	MOVE	IEND,L		;77	IF(IEND)IEND=L
38400	NX4:	HRRZI	R,XRN
38500		ADD	R,PTR+=252	;RN(IS+L)=A
38600		ADDI	R,(L)
38700		MOVEM	A,-1(R)
38800	NN3:	CAILE	L,1		;3	CONTINUE
38900		SOJA	L,N3
39000		CAIGE	IEND,3
39100		MOVEI	IEND,3
39200		MOVE	15,IEND		;IF(IEND.LT.3)IEND=3
39300		SUBI	15,2
39400		JSA 	16,UPDATE	;CALL UPDATE(IEND-2)
39500		JUMP	15
39600	NN2:	CAML	K,IZ		;2	CONTINUE
39700		JRA	16,(16)		;END
39800		ADDI	K,=10
39900		JRST	N2
40000	
40100		END